perm filename NETWRK.MID[S,NET]27 blob
sn#824720 filedate 1986-09-16 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00040 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00006 00002 Network routines, intended to be .INSRT'ed
C00010 00003 Assembly switches
C00015 00004 INTINR INTINS INTIMS INTINP RFCS RFCR CLSS CLSR SIU CCS SYS NLA ILB IDD GMM IOIMPM IODERR IODTER IOBKTL IODEND HDEAD RSET TMO ERRBTS WINBTS NET DAT NT$NUM NE%UNT NE%STR NN%IP NW%ARP NW%MIL NW%SI NW%SU
C00019 00005 NWKDBG HSTADR HSTTOP HDBPTR DHSTST TTYFIL TTYPPN TTBSIZ TTYNAM OPNBLK NETDEV CONBLK CONSTS CONLPR CONWAT CONBYT ICPSKT CONFPR HOST CONHST LSNBLK LSNSTS LSNSKT LSNPRT LSNWAT LSNBYT LSNFPR LSNHST STABLK STASND STARCV
C00023 00006 TERBLK TERSTS TERPRT TERWAI WATBLK WATSTS WATPRT INRBLK INRSTS INRPRT INSBLK INSSTS INSPRT ABTBLK ABTSTS RMKBLK RMKSTS RMKDAT UDPBLK UDPSTS UDPLPR UDPFPR UDPHST WHYWHY NTIBF NTOBF DTIBF DTOBF FSOCKT FBPORT LSOCKT LBPORT
C00026 00007 CONECT .CONEC
C00029 00008 LISTEN .LISTE
C00032 00009 DATI .DATI .DATI1
C00034 00010 DATO .DATO .DATO1
C00036 00011 CONCHK
C00037 00012 UDPCON .UDPCN
C00039 00013 NETICH NETICW NTICH2 NTICH4 NTICH3
C00042 00014 NETOCH .NETOC
C00043 00015 NETSND .NETSN NETOER
C00044 00016 DATICH DATICW DTICH2 DTICH3 DTICH1 DTIC1A
C00048 00017 DATOCH .DATOC
C00049 00018 DATSND .DATSN DATOER
C00051 00019 CLOSER CLSDAT CLOSEW
C00052 00020 NETINR NETINS ABORT
C00053 00021 MTPERR MTPER1 MTPE1A MERTAB MERLEN
C00057 00022 NIOERR NIOER2
C00058 00023 HSTDED
C00060 00024 HSTDE2
C00062 00025 HSTSID HSTFN1 HSTVRS HSTDIR HSTDEV HSTWHO HSTDAT HSTTIM NAMPTR SITPTR NETPTR NTNPTR HDRLEN NETNUM NTLNAM NTRTAB NETLEN ADDADR ADLSIT ADRCDR ADLXXX ADRSVC SVLCNT SVRCDR SVLFLG SVRNAM SVCARG ADDLEN STLNAM STRADR STLSYS STRMCH STLFLG STFSRV STFGWY SITLEN NMLSIT NMRNAM NAMLEN NNLNET NNRNAM NTNLEN HSTFIL HSTPPN LOCDOM
C00073 00026 MAPHS2 MAPHST MAPHS0 MAPHS4 MAPHS3
C00076 00027 UNMHST
C00077 00028 HSTNUM HSTNUS HSTNU1 HSTNU2
C00081 00029 HSTNAM SEARCH SRCLT SRCGT SRCDUN COMPAR PMATCH CHKAMB GOTNAM AMBNAM GETHDB HSTNAB HSTNB1 HSTNB2 HSTNB3 HSTNB4 HSTNB5 HSTUNK HSTUN1
C00092 00030 SRTADR SRTAD1 SRTAD2 SRTAD3 PRIORI PRIOR1 PRINUM NUMPRI PRIADR PRIMSK SRTADF
C00097 00031 HSTNXA
C00098 00032 SVCCHK SVCCH1 SVCCH2 SVCCH3
C00100 00033 SETANM SETAN1 SETAN2
C00107 00034 HSTNBR IPNBR HSTNBE PUPNBR TXTNUM TXTNU1
C00110 00035 HNUMST HNUMS1 HNUMS2 HNUMS3 HNUMS5 HNUMSD HNUMSO HNUMSX
C00113 00036 OURNAM OURNA1
C00115 00037 ATTHST ATTHS0 ATTHS2 ATTCRE ATTMUL ATTUPP ATTLOW ATTERR MXATTE HSGNAM
C00118 00038 DETHST
C00119 00039 B%ADDRESS B%EXISTS B%DEFL VERSIO BLKSIZ NETADR NUMTTY DEFBLK TTYBLK TTYSTR TTYST1 CPYNAM CPYNA1 TTYST9 TTYREA TTYRE1
C00130 00040 CPOPJ2 CPOPJ1 CPOPJ WARNIN LUZBIG ..NLIT
C00131 ENDMK
C⊗;
SUBTTL Network routines, intended to be .INSRT'ed
; This is a library of network hacking routines. Each routine describes its
; calling sequence and what AC's it smashes. A pushdown stack is expected in 17.
;
; I/O channel 0 is smashed, I/O channel 1 (NET) is used as the general TELNET
; connection channel, and I/O channel 2 (DAT) is used for data I/O.
; This package can also be used with the Ethernet as well, but data connections
; are not implemented. Also, Ethernet does not have equivalent to INTINR, and
; simply sends an INTINS. Host down messages are bogus. (TVR/Dec81)
; This is the MIDAS version which lives in NETWRK.MID[S,NET]. The FAIL version
; lives in NETWRK.FAI[S,NET].
COMMENT ⊗ History (please record changes):
History recording began in August 1986.
Apr 78 MRC Original NETWRK for Arpanet NCP.
Dec 81 TVR Added support for Ethernet PUP connections.
Apr 83 ME,JJW Modified for Arpanet IP/TCP. Major change is
the elimination of ICP for Arpanet connections.
Jun 83 JJW Host table format changed from HOSTS2 to HOSTS3.
(1983-1986) Numerous changes, undocumented.
09 Aug 86 JJW Commented out IP address lookup kludge. (Host table we
now get from Argus has Stanford IP addresses.) Added
SRTADR to sort addresses (by modifying the HOSTS3 table
incore). Changed HSTNAB and HNUMST to accept and print
PUP addresses in the form [a#b], but PUP code useless
since it parses in decimal.
13 Aug 86 JJW Added HSTNBR to parse [a.b.c.d] in decimal or [a#b] in
octal. Doesn't look up number in host table.
26 Aug 86 ME,JJW Added ATTHST and DETHST for upper-segment host table.
Disabled call to SRTADR for use of this feature.
03 Sep 86 JJW Changed DETHST not to save high segment, since [RSLV]
phantom does.
10 Sep 86 JJW Changed SETANM to always use official name, supressing
hyphens and stopping at first "." in name.
History: end of comment ⊗
; Assembly switches
IF1,[
IFDEF FTHST3,[
PRINTX/Please remove the FTHST3 switch and non-HOSTS3 code from this program.
All NETWRK-reading programs must now use HOSTS3 host numbers.
/];IFDEF FTHST3
];IF1
IFNDEF SVRRTS,SVRRTS==0 ; ≠ 0 → server (not user) routines
IFNDEF DATRTS,DATRTS==0 ; ≠ 0 → data channel routines
IFNDEF MRKCHR,MRKCHR==0 ; ≠ 0 → pass BSP mark bytes as characters
IFNDEF ERRHAN,ERRHAN==0 ; ≠ 0 → automagic error reporting in NIORTS
IFNDEF ERRINS,ERRINS==EXIT ; (iff ERRHAN≠0) what to do after an error
IFNDEF HSTSIX,HSTSIX==0 ; ≠ 0 → sixbit alias name hacking
IFNDEF TTYSTS,TTYSTS==0 ; ≠ 0 → code to get TTY location string
IFNDEF IPUDP,IPUDP==0 ; ≠ 0 → IP/UDP code
IFNDEF NIORTS,NIORTS==SVRRTS\DATRTS\ERRHAN ; ≠ 0 → network I/O routines
IFNDEF ERRTNS,ERRTNS==ERRHAN ; ≠ 0 → error reporting routines
IFNDEF HSTTAB,HSTTAB==HSTSIX ; ≠ 0 → host table routines
IFE NIORTS\ERRTNS\HSTTAB,.FATAL No NETWRK routines selected
IFE NIORTS,IFN SVRRTS\DATRTS\ERRHAN,.FATAL NIORTS Illegal switch setting
IFE ERRTNS,IFN ERRHAN,.FATAL ERRHAN Illegal switch setting
IFE HSTTAB,IFN HSTSIX,.FATAL HSTTAB Illegal switch setting
IFE NIORTS,IFN MRKCHR,.FATAL MRKCHR Illegal switch setting
; Macro definitions
DEFINE TMSG STRING
OUTSTR [ASCIZ\!STRING!\]
TERMIN
; FATAL errors type an exclamation point and halt. WARNings type a question
; mark and continue.
DEFINE FATAL STRING
PUSHJ 17,[OUTSTR [ASCIZ\!STRING!?\] ? JRST LUZBIG]
TERMIN
DEFINE WARN STRING
PUSHJ 17,[OUTSTR [ASCIZ\!STRING!!\] ? JRST WARNIN]
TERMIN
;Timeouts for various flavors of connection (CLOSE,RFNM,ALLOC,RFC,INPUT,IDLE)
;(pre-TCP definitions)
;IFNDEF CNTIMO,CNTIMO==010000170500 ; Connect
;IFNDEF LSTIMO,LSTIMO==011212360000 ; Listen
;IFNDEF TNTIMO,TNTIMO==011700050000 ; Telnet port
;IFNDEF DATIMO,DATIMO==022400070000 ; Data port
;TCP/PUP definitions. Because there is no ICP on a separate port, only
;one set of timeouts is defined for each type of connection. IMPSER no
;longer uses RFNM timeout, but PUPSER uses it to time out ACK failure.
IFNDEF CNTIMO,CNTIMO==011774170000 ; Connect
IFNDEF LSTIMO,LSTIMO==011774260000 ; Listen
IFDEF TNTIMO,[PRINTX/TNTIMO no longer defined in NETWRK
/]
IFNDEF DATIMO,DATIMO==022400070000 ; Data port
;Macro to zero all but network number in a word. Placed outside .BEGIN so
;programs .INSRTing this file can use it.
DEFINE GETNET AC,(ADDR)
IFNB [ADDR] MOVE AC,ADDR
TLNN AC,(17←32.) ; Check for non-Internet type addrs
TLNN AC,(1←31.) ; Internet address, see if class A net
TDZA AC,[77,,-1] ; Unternet or class A, zap low 3 octets
TLNN AC,(1←30.) ; Class B or C, see which.
TRZA AC,177777 ; Class B network, zap low 2 octets
TRZ AC,377 ; Class C net, only zap 1 low octet
TERMIN
;⊗ INTINR INTINS INTIMS INTINP RFCS RFCR CLSS CLSR SIU CCS SYS NLA ILB IDD GMM IOIMPM IODERR IODTER IOBKTL IODEND HDEAD RSET TMO ERRBTS WINBTS NET DAT NT$NUM NE%UNT NE%STR NN%IP NW%ARP NW%MIL NW%SI NW%SU
; System bits and bytes
.BEGIN NETWRK
; Interrupt condition bits
.U"INTINR==000100,, ; IMP INR
.U"INTINS==000040,, ; IMP INS
.U"INTIMS==000020,, ; IMP status change
.U"INTINP==000010,, ; IMP input waiting
; Network status flags
.U"RFCS== 200000,, ; RFC sent
.U"RFCR== 100000,, ; RFC received
.U"CLSS== 040000,, ; CLS sent
.U"CLSR== 020000,, ; CLS received
; Network status word error codes
.U"SIU==01 ; port (socket) in use
.U"CCS==02 ; can't change port (socket) numbers
.U"SYS==03 ; horrible system error
.U"NLA==04 ; no links available
.U"ILB==05 ; illegal byte size
.U"IDD==06 ; IMP dead
.U"GMM==07 ; Gender mismatch
; I/O status word error bits
.U"IOIMPM==400000 ; improper mode
.U"IODERR==200000 ; hard device error
.U"IODTER==100000 ; soft device error
.U"IOBKTL==040000 ; block number out of bounds
.U"IODEND==020000 ; end of file
.U"HDEAD== 002000 ; host or destination IMP dead
.U"RSET== 000400 ; host sent a RST
.U"TMO== 000200 ; time out
ERRBTS==IOIMPM\IODERR\IODTER\IOBKTL\IODEND\HDEAD\RSET\TMO
WINBTS==RFCS\RFCR ; connection winning
; I/O channel definitions
.U"NET==1 ; channel to do network hacking
.U"DAT==2 ; channel to do data hacking
; Network numbers (for distinguishing IMP from local Ethernet)
.U"NT$NUM==:301400 ;Byte pointer to network number (high 12 bits)
.U"NE%UNT==:040000,,0 ;Escape bit indicating "Unternet" type address
.U"NE%STR==:100000,,0 ;Escape bit indicating "string" type address
.U"NN%IP==:740000,,0 ;host number bits that are off for all IP addresses
.U"NW%ARP==:<10.←24.> ;HOSTS3 uses full word network # values
.U"NW%MIL==:<26.←24.> ;LLL is on MILnet
.U"NW%SI==:<44←24.> ;Internet address of SU-NET-TEMP
.U"NW%SU==:<NE%UNT+NW%SI> ;"Unternet" used for Stanford Ethernet
;⊗ NWKDBG HSTADR HSTTOP HDBPTR DHSTST TTYFIL TTYPPN TTBSIZ TTYNAM OPNBLK NETDEV CONBLK CONSTS CONLPR CONWAT CONBYT ICPSKT CONFPR HOST CONHST LSNBLK LSNSTS LSNSKT LSNPRT LSNWAT LSNBYT LSNFPR LSNHST STABLK STASND STARCV
; Data area
NWKDBG: 0 ; -1 → do OUTCHR on network I/O
IFN HSTTAB,[
; Host table pointers
.U"HSTADR: ; ≠ 0 → address of beginning of host table
BLOCK 1 ; = 0 → host table not in core
HSTTOP: BLOCK 1 ; top of host table (JOBFF at map time)
HDBPTR: BLOCK 1 ; pointer to relative HDB
; Block for ASCIZ text of dotted host number of host not in table
DHSTST: BLOCK 10
]; End IFN HSTTAB
IFN TTYSTS,[
TTYFIL: SIXBIT/TTYINI/ ;File of SU-Ethernet TTY information
SIXBIT/BIN/
TTYPPN: SIXBIT/HSTNET/
TTBSIZ: BLOCK 1 ;Size of TTY info block, read from file
TTYNAM: BLOCK 10 ;Block to return TTY string
];End IFN TTYSTS
IFN NIORTS,[
OPNBLK: 0
.U"NETDEV:'IMP,,0 ; device name
NTOBF,,NTIBF ; buffers
; CONNECT MTAPE block
CONBLK: 0 ; CONNECT
CONSTS: BLOCK 1 ; returned status bits
CONLPR: BLOCK 1 ; local port
CONWAT: BLOCK 1 ; ≠ 0 → wait for connection until timeout
CONBYT: BLOCK 1 ; byte size
.U"ICPSKT: ;(old name, for compatibility)
CONFPR: BLOCK 1 ; foreign port
.U"HOST:
CONHST: BLOCK 1 ; foreign host
IFN SVRRTS,[
; LISTEN MTAPE block
LSNBLK: 1 ; LISTEN
LSNSTS: BLOCK 1 ; returned status bits
.U"LSNSKT: ;(old name, for compatibility)
.U"LSNPRT:
BLOCK 1 ; local port to listen to
LSNWAT: BLOCK 1 ; ≠ 0 → wait for connection
LSNBYT: BLOCK 1 ; byte size
LSNFPR: BLOCK 1 ; foreign port
LSNHST: BLOCK 1 ; foreign host
]; End IFN SVRRTS
STABLK: 2 ;STATUS
STASND: BLOCK 1 ;Send side status
STARCV: BLOCK 1 ;Receive side status
;Both IMPSER and PUPSER store the same values in the above two words.
;⊗ TERBLK TERSTS TERPRT TERWAI WATBLK WATSTS WATPRT INRBLK INRSTS INRPRT INSBLK INSSTS INSPRT ABTBLK ABTSTS RMKBLK RMKSTS RMKDAT UDPBLK UDPSTS UDPLPR UDPFPR UDPHST WHYWHY NTIBF NTOBF DTIBF DTOBF FSOCKT FBPORT LSOCKT LBPORT
; More data area, shared by USER and SERVER
;TERMINATE MTAPE block
TERBLK: 3 ;TERMINATE
TERSTS: BLOCK 1 ;Returned status bits
TERPRT: BLOCK 1 ;Port number
TERWAI: BLOCK 1 ;Wait flag
ifn 0,[ ;Leftover from NCP days
; WAIT MTAPE block
WATBLK: 4 ; WAIT
WATSTS: BLOCK 1 ; returned status bits
WATPRT: BLOCK 1 ; port number
; INTERRUPT MTAPE blocks
INRBLK: 11 ; SEND INTERRUPT
INRSTS: BLOCK 1 ; returned status bits
INRPRT: BLOCK 1 ; port number
INSBLK: 11
INSSTS: BLOCK 1
INSPRT: BLOCK 1
];ifn 0
;ABORT MTAPE block
ABTBLK: 22 ;ABORT
ABTSTS: BLOCK 1 ;Returned status bits
IFN MRKCHR,[
RMKBLK: 26 ; READ MARK
RMKSTS: BLOCK 1
RMKDAT: BLOCK 1 ; mark byte returned here
]; End IFN MRKCHR
IFN IPUDP,[
UDPBLK: 26 ;Set UDP parameters
UDPSTS: BLOCK 1 ;Returned status bits
.U"UDPLPR:BLOCK 1 ;Local port
0
0
.U"UDPFPR:BLOCK 1 ;Foreign port
.U"UDPHST:BLOCK 1 ;Foreign host
];IFN IPUDP
; Other stuff
WHYWHY: BLOCK 1 ; host down word
; I/O buffer headers
NTIBF: BLOCK 3 ; network input buffer header
NTOBF: BLOCK 3 ; network output buffer header
IFN DATRTS,[
DTIBF: BLOCK 3 ; network data input buffer header
DTOBF: BLOCK 3 ; network data output buffer header
]; End IFN DATRTS
; Base ports, set up by CONECT and LISTEN
.U"FSOCKT: ;(old name, for compatibility)
.U"FBPORT:BLOCK 1 ; foreign base port
.U"LSOCKT: ;(old name, for compatibility)
.U"LBPORT:BLOCK 1 ; local base port
]; End IFN NIORTS
;⊗ CONECT .CONEC
; CONECT -- Connect to foreign host
; Call: MOVEM <host number>,HOST
; MOVEM <foreign port number>,CONFPR
; PUSHJ 17,CONECT
; <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0 and 1.
IFN NIORTS,[
IFE SVRRTS,[
; Open channels and set timeouts
.U"CONECT:
IFN ERRHAN,[
PUSHJ 17,.CONEC
JRST [PUSHJ 17,MTPERR ? ERRINS]
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.CONEC: GETNET 0,HOST ; check network type
MOVEI 1,'IMP ; Assume not PUP
CAMN 0,[NW%SU] ; Ethernet?
MOVEI 1,'PUP ; Yes, use PUP
MOVSM 1,NETDEV ; specify device for OPEN
CAIN 1,'PUP
HRRZS HOST ; Don't confuse PUPSER with net number
OPEN NET,OPNBLK ; open NET in ASCII mode
JRST [ MOVEI 0,0 ; failed, maybe device is detached
JRST CPOPJ1] ; return 0 to indicate no device
MTAPE NET,[17 ? CNTIMO]
SETOM CONLPR ; gensym local port
SETOM CONWAT ; do wait until timeout
MTAPE NET,CONBLK ; connect → foreign server
MOVE CONLPR ; get gensymmed port
MOVEM LBPORT ; save local base port
MOVE CONSTS ; get MTAPE status
MOVEM WHYWHY ; save it
GETSTS NET, ; check for I/O error on proper channel
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TRNE 77 ; check for MTAPE error
POPJ 17,
TLC (WINBTS) ; for next instruction to win
TLCE (WINBTS) ; legal state?
POPJ 17,
MOVE CONFPR ; get port we got
MOVEM FBPORT ; save foreign port for later
MOVE CONLPR ; for completeness and compatibilty
ifn 0,[
MOVEM INSPRT
];ifn 0
MOVEM TERPRT
MOVEI 8. ; change byte size in buffer header
DPB [300600,,NTIBF+1]
DPB [300600,,NTOBF+1]
INBUF NET,
OUTBUF NET,
MTAPE NET,[10]
CAI
JRST CPOPJ2
]; End IFE SVRRTS
;⊗ LISTEN .LISTE
; LISTEN -- Listen for a connection from a foreign host
; Call: MOVEM <local port number>,LSNPRT
; MOVEM <device name>,NETDEV ;If omitted, then use IMP
; PUSHJ 17,LISTEN
; <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return--host we connected to in HOST>
; Smashes 0 and 1.
IFN SVRRTS,[
; Open channels and set timeouts (punts after a minute)
.U"LISTEN:
IFN ERRHAN,[
PUSHJ 17,.LISTE
JRST [PUSHJ 17,MTPERR ? ERRINS]
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.LISTE: OPEN NET,OPNBLK ; open NET in ASCII mode
FATAL Network device INIT failure
MOVS 1,NETDEV
MTAPE NET,[17 ? LSTIMO]
SETOM LSNWAT ; do wait until timeout
MTAPE NET,LSNBLK
MOVE LSNSTS ; check for MTAPE error
MOVEM WHYWHY
TRNE 77
POPJ 17,
GETSTS NET, ; check for I/O error
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS) ; for next instruction to win
TLCE (WINBTS) ; legal state?
POPJ 17,
MOVE LSNHST
MOVEM CONHST
MOVE LSNFPR
MOVEM FBPORT ; save foreign base port
MOVE LSNPRT ; remember local port
MOVEM LBPORT
ifn 0,[
MOVEM INSPRT ; for completeness, set this as well
];ifn 0
MOVEM TERPRT
MOVEI 8. ; change byte size in buffer header
DPB [300600,,NTIBF+1]
DPB [300600,,NTOBF+1]
INBUF NET,
OUTBUF NET,
MTAPE NET,[10]
CAI
JRST CPOPJ2
]; End IFN SVRRTS
;⊗ DATI .DATI .DATI1
; DATI -- Open data input network channel
; Call: PUSHJ 17,DATI
; <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return--byte size in 0>
; Smashes 0 and 1.
IFN DATRTS,[
.U"DATI:
IFN ERRHAN,[
PUSHJ 17,.DATI
JRST [PUSHJ 17,MTPERR ? ERRINS]
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.DATI: CHNSTS DAT, ; check for channel open
JUMPN .DATI1
INIT DAT,0 ; open channel
'IMP,,
DTOBF,,DTIBF ; buffers
FATAL IMP INIT failure
MTAPE DAT,[17 ? DATIMO]
.DATI1: MOVE LBPORT
ADDI 4 ; ICP/U receive data offset
MOVEM CONLPR ; local receive port
MOVE FBPORT
ADDI 3 ; ICP/S transmit data offset
MOVEM CONFPR ; foreign transmit port
SETOM CONWAT ; wait
MTAPE DAT,CONBLK ; connect ← foreign data output
MOVE CONSTS ; test for error
MOVEM WHYWHY
TRNE 77
POPJ 17,
GETSTS DAT,
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS)
TLCE (WINBTS)
POPJ 17,
MTAPE DAT,[15 ? 1] ; system maximum allocation
MOVE CONBYT ; change byte size in buffer header
DPB [300600,,DTIBF+1]
INBUF DAT,
MTAPE DAT,[10]
CAI
JRST CPOPJ2
;⊗ DATO .DATO .DATO1
; DATO -- Open data output network channel
; Call: MOVEI <byte size of connection>
; PUSHJ 17,DATO
; <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0 and 1.
.U"DATO:
IFN ERRHAN,[
PUSHJ 17,.DATO
JRST [PUSHJ 17,MTPERR ? ERRINS]
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.DATO: MOVEM CONBYT
CHNSTS DAT,
JUMPN .DATO1
INIT DAT,0 ; open channel
'IMP,,
DTOBF,,DTIBF ; buffers
FATAL IMP INIT failure
MTAPE DAT,[17 ? DATIMO]
.DATO1: MOVE LBPORT
ADDI 5 ; ICP/U transmit data offset
MOVEM CONLPR ; local receive port
MOVE FBPORT
ADDI 2 ; ICP/S receive data offset
MOVEM CONFPR ; foreign transmit port
SETOM CONWAT ; wait
MTAPE DAT,CONBLK ; connect → foreign data input
MOVE CONSTS ; test for error
MOVEM WHYWHY
TRNE 77
POPJ 17,
GETSTS DAT,
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TLC (WINBTS)
TLCE (WINBTS)
POPJ 17,
MOVE CONBYT ; change byte size in buffer header
DPB [300600,,DTOBF+1]
OUTBUF DAT,
JRST CPOPJ2
]; End IFN DATRTS
;⊗ CONCHK
;CONCHK -- Check status of network connection.
;Call: PUSHJ 17,CONCHK
; <return if error or no connection open>
; <return if connection open and no error>
;Connection status is returned in 0 in either case.
.U"CONCHK:
MTAPE NET,STABLK ;Get status
MOVE STASND ;Pick up "send side" status
TRNE 77 ;Check for MTAPE error
POPJ 17,
TLC (WINBTS) ;For next instruction to win
TLCE (WINBTS) ;Legal state?
POPJ 17,
JRST CPOPJ1
;⊗ UDPCON .UDPCN
;;; Note: This code experimental and subject to change.
;UDPCON -- Set up IP/UDP connection.
;Call: MOVEM <host number>,UDPHST
; MOVEM <local port number or -1>,UDPLPR
; MOVEM <foreign port number or -1>,UDPFPR
; PUSHJ 17,UDPCON
; <error return--MTAPE lossage, status in 0> iff ERRHAN = 0
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
;Smashes 0 and 1.
IFN IPUDP,[
.U"UDPCON:
IFN ERRHAN,[
PUSHJ 17,.UDPCN
JRST [PUSHJ 17,MTPERR ? ERRINS]
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
];End IFN ERRHAN
.UDPCN: MOVEI 1,'IMP ;Can't do this with PUP!
MOVSM 1,NETDEV
OPEN NET,OPNBLK ;Open NET in ASCII mode
FATAL Network device INIT failure
MTAPE NET,UDPBLK ;Set UDP parameters for connection
MOVE UDPSTS ;Get MTAPE status
MOVEM WHYWHY ;Save it
GETSTS NET, ;Check for I/O error
TRNE ERRBTS
JRST CPOPJ1
MOVE WHYWHY
TRNE 77 ;Check for MTAPE error
POPJ 17,
MOVEI 8. ;Change byte size in buffer header
DPB [300600,,NTIBF+1]
DPB [300600,,NTOBF+1]
INBUF NET,
OUTBUF NET,
MTAPE NET,[17 ? CNTIMO]
JRST CPOPJ2
];End IFN IPUDP
;⊗ NETICH NETICW NTICH2 NTICH4 NTICH3
; NETICH/NETICW -- Read a character from the network
; Call: PUSHJ 17,NETICH or PUSHJ 17,NETICW
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <error return--no characters available> iff NETICH
; <return--character in 0>
; Smashes 0, 1, and 2.
.U"NETICH:
TDZA 2,2 ; don't hang
.U"NETICW:
SETO 2, ; hang
IFN ERRHAN,[
PUSHJ 17,NTICH2
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17, ; NETICW or empty NETICH
JRST CPOPJ1 ; NETICH return
]; End IFN ERRHAN
NTICH2: SOSLE NTIBF+2 ; anything in buffer?
JRST NTICH3
JUMPN 2,NTICH4
HRRZ 1,NTIBF
HRRZ 1,(1)
SKIPGE (1) ; anything in further buffers?
JRST NTICH4
MTAPE NET,[10] ; no, any input available?
JRST CPOPJ1 ; no, empty error return
NTICH4: IN NET, ; yes, read the buffer
JRST NTICH3 ; won
GETSTS NET, ; error, get status
IFN MRKCHR,[
TRNN 0,IOBKTL ; mark seen?
]; End IFN MRKCHR
POPJ 17, ; I/O error return
IFN MRKCHR,[
MTAPE NET,RMKBLK ; read mark byte
POPJ 17, ; failed
MOVE 0,RMKDAT
TRO 0,400 ; send it in specially marked package
JRST CPOPJ2 ; good return
]; End IFN MRKCHR
NTICH3: ILDB NTIBF+1 ; get the character
SKIPE NWKDBG
OUTCHR
JUMPN 2,CPOPJ1 ; NETICW only skips once
JRST CPOPJ2 ; NETICH good return
;⊗ NETOCH .NETOC
; NETOCH -- Output a character to the network
; Call: MOVE <character>
; PUSHJ 17,NETOCH
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0.
.U"NETOCH:
IFN ERRHAN,[
PUSHJ 17,.NETOC
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.NETOC: SOSG NTOBF+2 ; space available in buffer?
OUT NET, ; no, output it
CAIA ; win
JRST NETOER
IDPB NTOBF+1 ; put character in buffer
SKIPE NWKDBG
OUTCHR
JRST CPOPJ1 ; success
;⊗ NETSND .NETSN NETOER
; NETSND -- Force network buffer out
; Call: PUSHJ 17,NETSND
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
.U"NETSND:
IFN ERRHAN,[
PUSHJ 17,.NETSN
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.NETSN: OUT NET, ; send the buffer
JRST [ AOS NTOBF+2 ; poor NETOCH will lose big otherwise
JRST CPOPJ1]
NETOER: GETSTS NET, ; lost, get status
POPJ 17, ; and return
;⊗ DATICH DATICW DTICH2 DTICH3 DTICH1 DTIC1A
; DATICH/DATICW -- Read a character from the network data channel
; Call: PUSHJ 17,DATICH or PUSHJ 17,DATICW
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <error return--no characters available> iff DATICH
; <return--character in 0>
; Smashes 0, 1, and 2.
IFN DATRTS,[
.U"DATICH:
TDZA 2,2 ; don't hang
.U"DATICW:
SETO 2, ; hang
IFN ERRHAN,[
PUSHJ 17,DTICH2
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17, ; DATICW or empty DATICH
JRST CPOPJ1 ; DATICH return
]; End IFN ERRHAN
DTICH2: SOSLE DTIBF+2 ; anything in buffer?
JRST DTICH3
JUMPE 2,[ HRRZ 1,DTIBF
HRRZ 1,(1)
SKIPGE (1) ; anything in further buffers?
JRST .+1
MTAPE DAT,[10] ; no, any input available?
JRST CPOPJ1 ; no, empty error return
JRST .+1] ; input available or hang
IN DAT, ; yes, read the buffer
JRST DTICH3 ; won
GETSTS DAT, ; error, get status
POPJ 17, ; I/O error return
DTICH3: LDB [300600,,DTIBF+1] ; get byte size
CAIE 8.
JRST [ ILDB DTIBF+1 ; non-ASCII data mode
JUMPN 2,CPOPJ1
JRST CPOPJ2]
IBP DTIBF+1 ; increment pointer to hack
MOVE @DTIBF+1 ; get word to hack
ANDI 17 ; only marking bits
JFFO DTICH1 ; count leading zeros
LDB DTIBF+1 ; get the character
JUMPN 2,CPOPJ1 ; DATICW only skips once
JRST CPOPJ2 ; DATICH good return
; Have to flush nulls here.
DTICH1: MOVNI 1,-44(1) ; get -1,,# of padding characters
HRRZM 1,1(17) ; stash # of characters away on stack
MOVEI 1,-1(1) ; # of characters to take off buffer
SUBM 1,DTIBF+2 ; remove padding characters from count
MOVNS DTIBF+2 ; SUBM goes the wrong way
SKIPE 1 ; maybe no adjustment necessary
DTIC1A: IBP DTIBF+1
SOJG 1,DTIC1A ; increment byte ptr given nbr of bytes
MOVN 1,1(17) ; get # of characters back from stack
LSH 1,3 ; # of bits to shift over
MOVE @DTIBF+1 ; get word we are hacking
LSH (1) ; right justify its bytes
MOVEM @DTIBF+1 ; store it back again
JRST DTICH2 ; now try it again
;⊗ DATOCH .DATOC
; DATOCH -- Output a character to the network data channel
; Call: MOVE <character>
; PUSHJ 17,DATOCH
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0.
.U"DATOCH:
IFN ERRHAN,[
PUSHJ 17,.DATOC
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.DATOC: SOSG DTOBF+2 ; space available in buffer?
OUT DAT, ; no, output it
CAIA ; win
JRST DATOER
IDPB DTOBF+1 ; put character in buffer
JRST CPOPJ1 ; success
;⊗ DATSND .DATSN DATOER
; DATSND -- Force network buffer out
; Call: PUSHJ 17,DATSND
; <error return--I/O error, status in 0> iff ERRHAN = 0
; <return>
; Smashes 0 and 1.
.U"DATSND:
IFN ERRHAN,[
PUSHJ 17,.DATSN
JRST [PUSHJ 17,NIOERR ? ERRINS]
POPJ 17,
]; End IFN ERRHAN
.DATSN: LDB 1,[410300,,DTOBF+1] ; get position field
MOVEI 1
LSH (1) ; AC0 ← 2↑<# of null characters>
SOS ; AC0 ← mask to flush nulls
IORM @DTOBF+1 ; ensure padding nulls aren't sent
OUT DAT, ; send the buffer
JRST [ AOS DTOBF+2 ; poor NETOCH will lose big otherwise
JRST CPOPJ1]
DATOER: GETSTS DAT, ; lost, get status
POPJ 17, ; and return
]; End IFN DATRTS
;⊗ CLOSER CLSDAT CLOSEW
; CLOSER/CLSDAT -- Close a connection
; Call: PUSHJ 17,CLOSER or PUSHJ 17,CLSDAT
; <return>
; Smashes 0.
.U"CLOSER:
CLOSE NET,
RELEASE NET,
TMSG [
Connection closed.
]
POPJ 17,
IFN DATRTS,[
.U"CLSDAT:
CLOSE DAT,
RELEASE DAT,
POPJ 17,
]; End IFN DATRTS
;CLOSEW -- Close a connection and wait, using MTAPE for this.
;Call: PUSHJ P,CLOSEW
; <return>
.U"CLOSEW:
SETOM TERWAI ;Set wait flag
MTAPE NET,TERBLK ;Close connection
POPJ 17,
;⊗ NETINR NETINS ABORT
ifn 0,[ ;Leftover from NCP days
; NETINR/NETINS -- Send network interrupts to TELNET connection
; Call: PUSHJ 17,NETINR (or NETINS)
; <return>
; Smashes 0.
.U"NETINR:
MTAPE NET,INRBLK ; interrupt from receiver
POPJ 17,
.U"NETINS:
MTAPE NET,INSBLK ; interrupt from sender
POPJ 17,
];ifn 0
; ABORT -- Abort TCP connection (send reset)
; Call: PUSHJ 17,ABORT
; <return>
.U"ABORT:
CHNSTS NET,ABTSTS ;see if channel is open
HRLZS ABTSTS ;put INITB into sign bit
SKIPGE ABTSTS ;skip if no channel open
MTAPE NET,ABTBLK ;send TCP reset
POPJ 17,
]; End IFN NIORTS
;⊗ MTPERR MTPER1 MTPE1A MERTAB MERLEN
; MTPERR -- Explain MTAPE lossage
; Call: MOVE <MTAPE status bits>
; PUSHJ 17,MTPERR
; <return>
; Smashes 0 and 1.
IFN ERRTNS,[
.U"MTPERR:
TRNE 77 ; UUO lossage?
JRST MTPER1 ; yes, different message
TLNN (CLSR) ; closed by foreign host?
SKIPA 1,[[ASCIZ/Time out
/]]
MOVEI 1,[ASCIZ/Refused
/]
OUTSTR (1)
CLRBFI
POPJ 17,
; MTAPE UUO lossage
MTPER1: ANDI 77 ; only error code
CAILE MERLEN ; error code too high?
JRST [ TMSG [MTAPE error #]
IDIVI 10
ADDI "0
ADDI 1,"0
OUTCHR
OUTCHR 1
JRST MTPE1A]
;;; CAIN 0,15 ;Is it the "host dead" code?
;;; JRST HSTDED ;Yes, say why
MOVE 1,
MOVE 1,MERTAB-1(1) ;Get word from table
OUTSTR (1) ;Output the error string
TLNN 1,600000 ;Print crlf if not warning or fatal
TMSG [
]
TLNE 1,400000 ;Test for fatal error
JRST LUZBIG
TLNE 1,200000 ;Test for warning
MTPE1A: WARN
CLRBFI
POPJ 17,
;Bits in LH: 400000 if fatal error
; 200000 if warning
MERTAB: 200000,,[ASCIZ/Port in use/]
200000,,[ASCIZ/Can't change port/]
200000,,[ASCIZ/System error/] ; horrible IMPSER bug; RTS&STR but no DDB
[ASCIZ/No free links/]
200000,,[ASCIZ/Illegal byte size/]
[ASCIZ/IMP dead/]
200000,,[ASCIZ/Gender mismatch/] ; the Anita Bryant feature
;TOPS-10 error codes (from TCPSER.MAC[S,SYS]):
200000,,[ASCIZ/State error/] ;(10)
[ASCIZ/Can't get there from here/] ;(11)
400000,,[ASCIZ/Not enough internal buffer space/] ;(12)
[ASCIZ/Illegal host number/] ;(13)
[ASCIZ/Destination net unreachable/] ;(14)
[ASCIZ/Destination host unreachable/] ;(15)
[ASCIZ/Destination protocol unreachable/] ;(16)
[ASCIZ/Destination port unreachable/] ;(17)
200000,,[ASCIZ/Fragmentation needed and DF set/] ;(20)
200000,,[ASCIZ/Source route failed/] ;(21)
200000,,[ASCIZ/Destination unreachable: unknown code/] ;(22)
MERLEN==.-MERTAB
; NIOERR ;⊗ NIOER2
; NIOERR -- Explain network I/O lossage
; Call: MOVE <I/O status bits>
; PUSHJ 17,NIOERR
; <return>
; Smashes 0, 1, and 2.
.U"NIOERR:
JUMPE 0,NIOER2 ;no bits means OPEN failed
ANDI ERRBTS ; only error bits
SKIPN
FATAL No error status
CLRBFI
TRNE IOBKTL
FATAL Block too large
TRNE IOIMPM
TMSG [Connection closed
]
TRNE RSET
TMSG [Connection was reset
]
TRNE TMO
TMSG [Time out
]
TRNE IODEND
TMSG [Host closed connection
]
TRNE HDEAD
JRST HSTDED
POPJ 17,
NIOER2: OUTSTR [ASCIZ/Network device unavailable (maybe being debugged)
/]
CLRBFI
POPJ 17,
;⊗ HSTDED
; HSTDED -- Explain why a host is dead
HSTDED: LDB [260400,,WHYWHY] ; get what's wrong first
JUMPE [ TMSG [Net trouble
]
POPJ 17,] ; 0 → destination IMP down
CAIE 1 ; 1 → destination host down
JRST [ CAIN 2 ; 2 → destination host talks 32 bit leaders
JRST [ TMSG [Communication with host not possible because it only talks 32 bit leaders
This probably indicates a hardware error at the other host, since 32-bit
leaders have been invalid since January 1, 1981.
]
POPJ 17,]
ifn 0,[
cain 17 ; Funny code from CONECT for bad net?
JRST [ TMSG [Host net is inaccessible
]
POPJ 17,]
];ifn 0
TMSG [Communication prohibited!
] ; 3 → host access prohibited
POPJ 17,]
TMSG [Host dead, ]
LDB 1,[220400,,WHYWHY] ; dead host status
OUTSTR @(1)[ [ASCIZ/reason unknown/]
[ASCIZ/system down/]
[ASCIZ/foreign NCP down/]
[ASCIZ/host doesn't exist/]
[ASCIZ/NCP initialization/]
[ASCIZ/scheduled PM/]
[ASCIZ/hardware work/]
[ASCIZ/software work/]
[ASCIZ/emergency restart/]
[ASCIZ/power failure/]
[ASCIZ/software breakpoint/]
[ASCIZ/hardware error/]
[ASCIZ/scheduled down/]
[ASCIZ/down code #13/]
[ASCIZ/down code #14/]
[ASCIZ/coming up now/]]
TMSG [
]
;⊗ HSTDE2
; Hairy "when host up" code
LDB [061400,,WHYWHY] ; get time when back up
JUMPE CPOPJ
CAIN 7776 ; -2 → unknown future time
POPJ 17,
TMSG [ Host is expected back up ]
CAIN 7777 ; -1 → more than a week
JRST [ TMSG [over a week from now.]
POPJ 17,]
LDB 1,[040500,,] ; 1.5→1.9 hours
LDB 2,[110300,,] ; 2.1→2.3 day of week
SUBI 1,8. ; PST/GMT offset
MOVEI 3,261 ; DAYLIT
PEEK 3,
PEEK 3,
SKIPE 3
AOSL 1 ; daylight losing time
JUMPGE 1,HSTDE2
ADDI 1,24. ; hours become positive again
SOJGE 2,HSTDE2 ; back up a day
MOVEI 2,6 ; back to Monday
HSTDE2: OUTSTR @(2)[ [ASCIZ/on Monday at /]
[ASCIZ/on Tuesday at /]
[ASCIZ/on Wednesday at /]
[ASCIZ/on Thursday at /]
[ASCIZ/on Friday at /]
[ASCIZ/on Saturday at /]
[ASCIZ/on Sunday at /]
[ASCIZ/on April Fool's Day at /]]
IDIVI 1,10.
ADDI 1,"0
OUTCHR 1
ADDI 2,"0
OUTCHR 2
OUTCHR [":]
LDB 1,[000400,,] ; 1.1→1.4 minutes/5
IMULI 1,5. ; make into real minutes
IDIVI 1,10.
ADDI 1,"0
OUTCHR 1
ADDI 2,"0
OUTCHR 2
JUMPE 3,[ TMSG [ PST
]
POPJ 17,]
TMSG [ PDT
]
POPJ 17,
]; End IFN ERRTNS
;⊗ HSTSID HSTFN1 HSTVRS HSTDIR HSTDEV HSTWHO HSTDAT HSTTIM NAMPTR SITPTR NETPTR NTNPTR HDRLEN NETNUM NTLNAM NTRTAB NETLEN ADDADR ADLSIT ADRCDR ADLXXX ADRSVC SVLCNT SVRCDR SVLFLG SVRNAM SVCARG ADDLEN STLNAM STRADR STLSYS STRMCH STLFLG STFSRV STFGWY SITLEN NMLSIT NMRNAM NAMLEN NNLNET NNRNAM NTNLEN HSTFIL HSTPPN LOCDOM
; Host table routines
IFN HSTTAB,[
; Herein is the description of the compiled binary file (HOSTS3.BIN).
; General terms:
; "fileaddr" = a file address, relative to start of file.
; "netaddr" = a network address, in HOSTS3 format.
;
; All strings (hostnames etc) are uppercase ASCIZ, word-aligned and
; fully zero-filled in the last word. The strings are stored in the
; file in such a way that their locations are sorted, and only ONE
; copy of any distinct string is stored - everything that references
; the same string points to the same place. Thus it is reasonable to
; compare string pointers for = as well as < and >, which is much
; faster than comparing the strings.
;The format of the compiled output file is:
HSTSID==:0 ; wd 0 SIXBIT /HOSTS3/
HSTFN1==:1 ; wd 1 SIXBIT FN1 of source file (eg HOSTS)
HSTVRS==:2 ; wd 2 SIXBIT FN2 of source file (TNX: version #)
HSTDIR==:3 ; wd 3 SIXBIT directory name of source file (eg SYSENG)
HSTDEV==:4 ; wd 4 SIXBIT device name of source file (eg AI)
HSTWHO==:5 ; wd 5 SIXBIT login name of person who compiled this
HSTDAT==:6 ; wd 6 SIXBIT Date of compilation as YYMMDD
HSTTIM==:7 ; wd 7 SIXBIT Time of compilation as HHMMSS
NAMPTR==:10 ; wd 10 Fileaddress of NAME table.
SITPTR==:11 ; wd 11 Fileaddress of SITE table.
NETPTR==:12 ; wd 12 Fileaddress of NETWORK table.
NTNPTR==:13 ; wd 13 Fileaddress of NETNAME table.
;....expandable....
HDRLEN==:14 ; length of header
; NETWORK table
; wd 0 Number of entries in table.
; wd 1 Number of words per entry. (2)
; This table contains one entry for each known network.
; It is sorted by network number.
; Each entry contains:
NETNUM==:0 ; wd 0 network number (full netaddr)
NTLNAM==:1 ; wd 1 LH - fileaddr of ASCIZ name of network
NTRTAB==:1 ; wd 1 RH - fileaddr of network's ADDRESS table
NETLEN==:2
; ADDRESS table(s)
; wd 0 Number of entries in table.
; wd 1 Number of words per entry. (3)
; There is one of these tables for each network. It contains entries
; for each site attached to that network, sorted by network address.
; These tables are used to convert a numeric address into a host name.
; Also, the list of network addresses and services for a site is stored
; within these tables.
; Each entry contains:
ADDADR==:0 ; wd 0 Network address of this entry, in HOSTS3 fmt.
ADLSIT==:1 ; wd 1 LH - fileaddr of SITE table entry
ADRCDR==:1 ; wd 1 RH - fileaddr of next ADDRESS entry for this site
; 0 = end of list
ADLXXX==:2 ; wd 2 LH - unused
ADRSVC==:2 ; wd 2 RH - fileaddr of services list for this address
; 0 = none, else points to SERVICE node of format:
SVLCNT==:0 ; <# wds>,,<fileaddr of next, or 0>
SVRCDR==:0
SVLFLG==:1 ; <flags>,,<fileaddr of svc name>
SVRNAM==:1
SVCARG==:2 ; <param1> ? <param2> ? ...
ADDLEN==:3
; SITE table
; wd 0 Number of entries in table.
; wd 1 Number of words per entry. (3)
; This table contains entries for each network site,
; not sorted by anything in particular. A site can have more
; than one network address, usually on different networks.
; This is the main, central table.
; Each entry looks like:
STLNAM==:0 ; wd 0 LH - fileaddr of official host name
STRADR==:0 ; wd 0 RH - fileaddr of first ADDRESS table entry for this
; site. Successive entries are threaded
; together through ADRCDR.
STLSYS==:1 ; wd 1 LH - fileaddr of system name (ITS, TIP, TENEX, etc.)
; May be 0 => not known.
STRMCH==:1 ; wd 1 RH - fileaddr of machine name (PDP10, etc.)
; May be 0 => not known.
STLFLG==:2 ; wd 2 LH - flags:
STFSRV==:400000 ; 4.9 1 => server site (has FTP or TELNET)
STFGWY==:200000 ; 4.8 1 => Internet Gateway site (HOSTS3 only)
SITLEN==:3
; NAMES table:
; wd 0 Number of entries
; wd 1 Number of words per entry. (1)
; This table is used to convert host names into network addresses. It
; contains entries sorted alphabetically by host name.
NMLSIT==:0 ; wd 0 LH - fileaddr of SITE table entry for this host.
NMRNAM==:0 ; wd 0 RH - fileaddr of host name
; This name is official if NMRNAM = STLNAM of NMLSIT.
NAMLEN==:1
; NETNAME table:
; wd 0 Number of entries
; wd 1 Number of words per entry. (1)
; This table is used to convert network names into network numbers. It
; contains entries sorted alphabetically by network name, exactly as
; for the NAMES table. Although the symbols below are different (in order
; to make semantic distinctions), programs can depend on the fact
; that the NETNAME table format is identical to that of the NAMES table.
NNLNET==:0 ; wd 0 LH - fileaddr of NETWORK table entry for this host.
NNRNAM==:0 ; wd 0 RH - fileaddr of network name
NTNLEN==:1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;; HOSTS3 Network Address Format ;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
comment |
HOSTS3 network address format:
4.9-4.6 - 4 bits of format type, which specify interpretation of
the remaining 32 bits.
IN 0000 - Internet address (handles ARPA, RCC, LCS)
4.5-1.1 - 32 bits of IN address.
UN 0001 - Unternet address. Same format, but not part of Internet.
4.5-3.7 - HOSTS3-defined network number (1st 8-bit byte)
3.6-1.1 - address value in next 24 bits.
This handles CHAOS and any local nets. The network
numbers are unique within the HOSTS3 table but
don't necessarily mean anything globally, as do
Internet network numbers.
0011 - String address.
4.5-3.7 - HOSTS3-defined network number (1st 8-bit byte)
3.6-3.1 - 0
2.9-1.1 - address of ASCIZ string in file/process space
Note that the "network number" for all of these formats is located in
the same place. However, for fast deciphering of the entire range of
possibilities, one could simply consider all of the high 12 bits as the
network number. Beware of the Internet class A, B, and C formats, though;
the only truly general way to compare network numbers is to use their
masked 36-bit values, although simpler checks are OK for specific nets.
For this reason (among others) network numbers are represented by
full 36-bit values with the "local address" portion zero.
The 4-bit "String address" value is much more tentative than the IN or UN
values. Bit 4.9, the sign bit, is being reserved as usual for the possible
advent of a truly spectacular incompatible format.
|
HSTFIL: SIXBIT/HOSTS3/ ;filename and extension of binary file
SIXBIT/BIN/
HSTPPN: SIXBIT/HSTNET/ ;PPN of binary file
;The following is for a kludge in HSTNAM. It should be read from the file.
LOCDOM: ASCIZ/Stanford.EDU/ ;Local domain's parent
;⊗ MAPHS2 MAPHST MAPHS0 MAPHS4 MAPHS3
; MAPHST -- Map host table into core
; Call: PUSHJ 17,MAPHST
; <return>
; Smashes 0, 1, 2, and 3.
MAPHS2: HRROS (17) ;indicate want host table in new upper segment
JRST MAPHS0
.U"MAPHST:
HRRZS (17) ;indicate want host table in lower segment
MAPHS0: SKIPE HSTADR
JRST [ WARN Host table already mapped
POPJ 17,]
INIT 17
'DSK,,
0
FATAL DSK INIT failure
DMOVE HSTFIL ; get filename and extension
MOVE 3,HSTPPN ; get PPN
LOOKUP
JRST [ TMSG [Host table LOOKUP failure (]
ANDI 1,77
IDIVI 1,10
ADDI 1,"0 ? ADDI 2,"0
OUTCHR 1 ? OUTCHR 2 ? OUTCHR [")]
JRST LUZBIG]
MOVS 0,3 ;unswap file length
MOVN 0,0 ;make file length positive
SKIPGE (17) ;going into upper?
JRST MAPHS3 ;yes
MOVE 2,JOBFF ;place to put table
ADDB 0,JOBFF ;get address of highest addr we need
MOVEM 0,HSTTOP
CORE 0, ;get more core from system maybe
FATAL CORE UUO failure
MAPHS4: MOVE 0,3 ;negative length in LH
HRRI 0,-1(2) ;compute IOWD to read host table in
MOVEI 1,0
INPUT 0 ;read whole host table
MOVE 0,(2) ;get first word of host table
CAME 0,HSTFIL
FATAL Bad host table
MOVEM 2,HSTADR ;remember where host table begins
RELEAS
POPJ 17,
MAPHS3: MOVEI 2,400000 ;place to put host table, beginning of upper
ADDI 0,(2) ;ending address of table
MOVEM 0,HSTTOP ;end of table
CORE2 0, ;get enough core in upper segment
FATAL CORE2 UUO failed for host table space in segment
JRST MAPHS4
;⊗ UNMHST
; UNMHST -- Unmap host table from core
; Call: PUSHJ 17,UNMHST
; <return>
; Smashes 0 and 1.
.U"UNMHST:
SKIPN 1,HSTADR ; host table in core?
JRST [ WARN Host table not mapped
POPJ 17,]
MOVE (1)
CAME HSTFIL
FATAL Bad host table
MOVE HSTTOP ; check JOBFF from before
CAMLE JOBFF ; smashed too?
FATAL Host table after JOBFF
CAME JOBFF
JRST [ WARN Host table locked
POPJ 17,]
SETZM HSTADR ; remove table pointer/interlock
MOVEM 1,JOBFF ; return host table to free storage
CORE 1, ; and garbage collect
FATAL CORE UUO failure
POPJ 17,
;⊗ HSTNUM HSTNUS HSTNU1 HSTNU2
; HSTNUM -- Return descriptor block for a host
; Call: MOVEI <host number>
; PUSHJ 17,HSTNUM
; <error return--no such host>
; <return--absolute NAMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2,
; address block in 3>
; Smashes 0, 1, 2, 3, and 4.
.U"HSTNUM:
SKIPN 1,HSTADR ; fail if host table not mapped
FATAL Host table not mapped
MOVE 2,(1)
CAME 2,HSTFIL
FATAL Bad host table
GETNET 4,0 ; get network number
MOVE 1,NETPTR(1)
PUSHJ 17,HSTNUS ; lookup network number
POPJ 17,
MOVE 1,NTRTAB(1) ; get address table for network
MOVEM 4 ; thing to search for
PUSHJ 17,HSTNUS ; lookup address
POPJ 17,
MOVE 3,1 ; Save address table entry
HLRZ 1,ADLSIT(1) ; Get site table entry
ADD 1,HSTADR
AOS (17) ; successful return
JRST GETHDB ; return useful stuff in ACs
HSTNUS: ADD 1,HSTADR ; relocate table
MOVE 2,(1) ; get # of entries
MOVE 3,1(1) ; and entry size
ADDI 1,2 ; point at first entry
HSTNU1: CAMN 4,(1) ; found it?
JRST CPOPJ1 ; yes, skip return for success
ADD 1,3 ; point at next entry
SOJG 2,HSTNU1 ; keep on searching
ifn 0,[ ;JJW 8/86 We now get IP addresses from Argus host table
;Special treatment for failed search on SU-NET hosts, to look up name using
;SU-ETHERNET (PUP) host number. Note that this code depends on knowing the
;format of SU-Net host numbers (currently class A). Hopefully this code can
;disappear someday, when our host table contains the IP numbers of these hosts.
TDZ 4,[77,,-1] ;Get class-A host number
CAME 4,[NW%SI] ;SU-Net?
JRST HSTNU2 ;No
PUSH 17,0 ;Save original (IP) host number
LDB 4,[201000,,0] ;Get subnet from bits 12-19
DPB 4,[102000,,0] ;Store in bits 20-27, clear 12-19
TLC 0,(NW%SI#NW%SU) ;Change net number
PUSHJ 17,HSTNUM ;Call ourself!
JRST [ POP 17,0 ;Still failed. Oh well.
JRST HSTNU2] ;Make ASCIZ string for IP host number
POP 17,0 ;Get back IP host number
POP 17,(17) ;Avoid going to GETHDB again
JRST CPOPJ1 ;Skip return to caller of HSTNUM
HSTNU2:
];ifn 0
;Host not in our host table. Generate ASCIZ string for host number
;instead of name.
MOVEI 1,DHSTST ;Address for ASCIZ host number string
PUSHJ 17,HNUMST ;Preserves 1
SETZM HDBPTR ;no HDB
SETZB 2,3
POPJ 17, ;failure return
;⊗ HSTNAM SEARCH SRCLT SRCGT SRCDUN COMPAR PMATCH CHKAMB GOTNAM AMBNAM GETHDB HSTNAB HSTNB1 HSTNB2 HSTNB3 HSTNB4 HSTNB5 HSTUNK HSTUN1
;HSTNAM -- Return descriptor block for a host name
;Call: MOVEI 0,<pointer to host name string>
; PUSHJ 17,HSTNAM
; <error return--no such host>
; <error return--ambiguous name>
; <return--absolute NUMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2
; next address block in 3>
;Smashes 0 → 11 (!!!).
;Rewritten Apr 86 by JJW. Original code did a linear search through the
;names table and required all-upper-case names in the table. New code
;does binary search since HOSTS3 names table is sorted, and does
;case-insensitive comparisons.
.U"HSTNAM:
SKIPN 1,HSTADR ;Fail if host table not mapped
FATAL Host table not mapped
MOVE 2,(1)
CAME 2,HSTFIL
FATAL Bad host table
;Set up various AC's for search.
HRLI 0,440700 ;Make byte pointer
MOVE 4,0 ;Set up for HSTNAB
ILDB 2,4 ;Get first char
CAIN 2,"[
JRST HSTNAB ;Parse bracketed host number
MOVE 1,NAMPTR(1)
ADD 1,HSTADR ;Address of NAMES table
HRLI 1,2(1) ;<first entry>,,<addr of table>
ADD 1,(1) ;<first entry>,,<last entry>+1
PUSH 17,1 ;Save for use in SRCDUN
SUBI 1,1 ;<first entry>,,<last entry>
;Host name search. AC's during search hold the following:
; 0: byte pointer to source string
; 1: <beginning>,,<ending> of current range in NAMES table
; 2: current entry in NAMES table being tested
SEARCH: HLRZ 2,1 ;Beginning of current range
CAILE 2,(1) ;Beyond end?
JRST SRCDUN ;Yes, search done
ADDI 2,(1) ;Add beginning and ending
LSH 2,-1 ;Compute midpoint
HRRZ 7,NMRNAM(2)
ADD 7,HSTADR ;Pointer for this entry
HRLI 7,440700
MOVE 6,0 ;Copy of source pointer
PUSHJ 17,COMPAR
JRST SRCGT
JRST SRCLT
JRST [ HLRZ 1,NMLSIT(2) ;Exact match!
ADD 1,HSTADR
ADJSP 17,-1 ;Fix up stack ptr
JRST GOTNAM]
;Fall into SRCLT if partial match
;Here if source string less than table entry.
SRCLT: HRRI 1,-1(2) ;Set end of range to before entry
JRST SEARCH
;Here if source string greater than table entry.
SRCGT: HRLI 1,1(2) ;Set beginning of range to after entry
JRST SEARCH
;Here when binary search done. Unless we got an exact match, we need
;to compare the source against all possible names that might be a partial
;match, to check for ambiguities.
SRCDUN: POP 17,1 ;Get back <first entry>,,<last entry+1>
SUBM 2,1 ;- <Max # of entries to check>
HRL 2,1 ;Make AOBJN ptr
SETZ 3, ;No match yet
SRCDU1: HRRZ 7,NMRNAM(2)
ADD 7,HSTADR ;Pointer for this entry
HRLI 7,440700
MOVE 6,0 ;Copy of source pointer
PUSHJ 17,COMPAR
JRST SRCDU2
JRST CHKAMB ;Done, now check for ambiguity
HALT . ;Exact match can't happen here!
PUSHJ 17,PMATCH ;Handle partial match
SRCDU2: AOBJN 2,SRCDU1
JRST CHKAMB ;Hit end of table
;Subroutine to compare two names given by byte pointers in 6 and 7.
;Returns: +1 if (6) .gt. (7)
; +2 if (6) .lt. (7) and is not a partial match
; +3 if (6) matches (7) exactly
; +4 if (6) matches a substring of (7)
;ACs 10 and 11 hold the most recent characters read from each string.
COMPAR: ILDB 10,6 ;Get next byte from each string
ILDB 11,7
JUMPE 10,[JUMPE 11,CPOPJ2 ;Exact match
AOS (17) ;Partial match
JRST CPOPJ2]
JUMPE 11,CPOPJ ;Partial match the other way
CAIL 10,"a ;Use upper case for comparisons
SUBI 10,40
CAIL 11,"a
SUBI 11,40
CAIGE 10,(11)
AOSA (17)
CAILE 10,(11)
POPJ 17,
JRST COMPAR ;Characters match, keep comparing
;Here to handle a partial match. If there was a previous partial match,
;AC 3 contains <flags>,,<HDB ptr>. Bits in <flags> are
; 10 if character after partial match is a "."
; 4 if, in addition, "." is followed by parent of our local domain
; 2 if host is a server
; 1 if ambiguous
;These are set up so that higher-valued combinations are "better" matches
;than lower-valued ones. When a different host with the same bits is
;matched, the ambiguous bit is set. Further matches at the same level
;will be ignored since they now appear worse, but a better match will
;clear the ambiguity bit.
PMATCH: HLRZ 5,NMLSIT(2) ;Set up pointer to HDB
ADD 5,HSTADR
HLLZ 6,STLFLG(5) ;HOSTS3 flags in LH
TLNE 6,STFSRV ;Server?
TRO 6,2 ;Yes, set our flag in RH
CAIE 11,". ;Subdomain name match?
JRST PMATC2 ;No
TRO 6,10 ;Yes
PUSH 17,6
MOVE 6,[440700,,LOCDOM] ;Our local domain's parent
PUSHJ 17,COMPAR ;Compare with remainder of (7)
JRST PMATC1
JRST PMATC1
JRST [POP 17,6 ? TRO 6,4 ? JRST PMATC2] ;Exact match, set flag
PMATC1: POP 17,6
PMATC2: HLRZ 4,3 ;Get flags from previous match
SKIPE 3 ;First partial match?
CAIGE 4,(6) ;Or this one better?
JRST [ MOVEI 3,(5) ;Yes, save new host entry
HRLI 3,(6) ;And flags
POPJ 17,]
CAILE 4,(6) ;This one worse?
POPJ 17, ;Yes, keep looking
CAIE 5,(3) ;Bits are equal. Same host?
TLO 3,1 ;No. Set ambiguity flag
POPJ 17,
;Search done, set up HDB ala HSTNUM and return
CHKAMB: JUMPE 3,CPOPJ ;Jump if no match at all
HRRZ 1,3 ;HDB of best match
TLNN 3,1 ;Ambiguous name?
GOTNAM: AOS (17) ;No, set up double skip return
AMBNAM: AOS (17) ;Ordinary skip return
;Routine to get a block of host specifications with pointer in 1.
;;Commented out for now -- won't work with shared upper segment
;; PUSHJ 17,SRTADR ;Sort address list
HRRZ 3,STRADR(1) ;Get address block
ADD 3,HSTADR
MOVE 0,ADDADR(3) ;First address
GETHDB: MOVE 2,STRMCH(1) ;NUMBTS,,NUMMCH
HLL 2,STLFLG(1)
TRNE 2,-1
ADD 2,HSTADR
MOVEM 1,HDBPTR ;Save pointer to HDB
SUB 1,HSTADR
EXCH 1,HDBPTR
HLL 1,STLSYS(1)
HLR 1,STLNAM(1) ;NUMSYS,,NUMNAM
ADD 1,HSTADR ;Relocate right half
TLNN 1,-1
POPJ 17, ;Case of unknown system name
MOVS 1,1
ADD 1,HSTADR ;Relocate left half
MOVS 1,1
POPJ 17, ;And return
;Parse a bracketed specification of the form [a.b.c.d] (IP) or [a#b] (PUP).
HSTNAB: SETZ 0, ;0 will hold result
MOVEI 1,4 ;Number of bytes (assume IP)
HSTNB1: SETZ 2, ;Value of current byte
HSTNB2: ILDB 3,4 ;Get next char
CAIL 3,"0
CAILE 3,"9
JRST HSTNB3 ;Non-numeric
IMULI 2,10.
ADDI 2,-"0(3)
JRST HSTNB2
HSTNB3: CAILE 2,255. ;Legal byte?
POPJ 17, ;No, lose
LSH 0,8.
ADDI 0,(2) ;Add in current byte
SOJLE 1,HSTNB4 ;Count bytes
CAIN 3,". ;IP delimiter?
JRST HSTNB1 ;Yes, scan next byte
CAIE 3,"# ;PUP delimiter?
POPJ 17, ;No, bad format
ADD 0,[NW%SU←-8.] ;Yes, set Unternet network number
MOVEI 1,1 ;Scan just 1 more byte
JRST HSTNB1
HSTNB4: JUMPE 3,HSTNB5 ;Allow omission of final delimiter
CAIE 3,"] ;Last delimiter is different
POPJ 17,
ILDB 3,4 ;Check for garbage at end
JUMPN 3,CPOPJ
HSTNB5: PUSH 17,0
PUSHJ 17,HSTNUM ;Look it up if we can
DMOVE 1,HSTUN1 ;Not in table - use dummy data
POP 17,0
JRST CPOPJ2
HSTUNK: ASCIZ/unknown/
HSTUN1: HSTUNK,,HSTUNK
0,,HSTUNK
;⊗ SRTADR SRTAD1 SRTAD2 SRTAD3 PRIORI PRIOR1 PRINUM NUMPRI PRIADR PRIMSK SRTADF
;Sort address list for the site in AC 1, so that programs can try the most
;preferred addresses first. It is better to do this here than to pre-sort
;the host table, because it allows different WAITS sites to share the same
;table, and might still be usable once we switch from tables to domain
;servers.
;We allow ourselves to use an O(n↑2) sorting algorithm (bubblesort), and
;recompute the priorities of addresses on each pass, because we never
;expect to have more than a handful of addresses for a single host.
SRTADR: SETZM SRTADF ;Clear flag - no exchanges yet
MOVEI 2,STRADR-ADRCDR(1) ;Make pseudo-address block pointer
HRRZ 3,ADRCDR(2)
ADD 3,HSTADR ;Get first real address block
MOVE 0,ADDADR(3)
PUSHJ 17,PRIORI ;Priority of first address
SRTAD1: MOVE 5,6 ;Save for comparison
HRRZ 4,ADRCDR(3)
JUMPE 4,SRTAD3 ;End of list - see if done
ADD 4,HSTADR ;Next address block
MOVE 0,ADDADR(4)
PUSHJ 17,PRIORI ;Priority of next address
CAML 5,6 ;Need to swap?
JRST SRTAD2
SETOM SRTADF ;Yes, flag a change
HRRZ 0,ADRCDR(4) ;Shuffle pointers
HRRM 0,ADRCDR(3)
SUB 3,HSTADR
HRRM 3,ADRCDR(4)
ADD 3,HSTADR
SUB 4,HSTADR
HRRM 4,ADRCDR(2)
ADD 4,HSTADR
EXCH 5,6 ;Swap priorities correspondingly
SRTAD2: MOVE 2,3 ;Step forward through list
MOVE 3,4
JRST SRTAD1
SRTAD3: SKIPE SRTADF ;Any changes this pass?
JRST SRTADR ;Yes, do another pass
POPJ 17, ;No, all done
PRIORI: MOVSI 7,-NUMPRI
PRIOR1: XOR 0,PRIADR(7) ;Compare with an address
TDNN 0,PRIMSK(7) ;See if any masked bits are different
JRST [ MOVE 6,PRINUM(7);No difference, assign priority
POPJ 17,]
XOR 0,PRIADR(7) ;Restore address
AOBJN 7,PRIOR1
SETZ 6,
POPJ 17,
;In the following list, addresses that are more specific should be
;earlier. I.e., a subnetwork should precede its parent network, so
;that the comparison on the subnetwork will take precedence.
DEFINE PRILST
PRIMAC 26,<004411,,0>,<777777,,600000> ;Internet MJH 3MB
PRIMAC 23,<004402,,0>,<777777,,600000> ;Internet MJH 10MB
PRIMAC 20,<004400,,0>,<777700,,000000> ;Internet SU-Net
PRIMAC 16,<044400,,022000>,<777777,,777400> ;Pup MJH 3MB
PRIMAC 13,<044400,,004000>,<777777,,777400> ;Pup MJH 10MB
PRIMAC 10,<044400,,000000>,<777700,,000000> ;Pup SU-Net
PRIMAC 6,<001200,,0>,<777700,,0> ;Arpanet
PRIMAC 4,<003200,,0>,<777700,,0> ;Milnet
PRIMAC 2,<000000,,0>,<740000,,0> ;Any Internet address
TERMIN
DEFINE PRIMAC NUM,(ADDR),(MASK)
NUM
TERMIN
PRINUM: PRILST
NUMPRI==.-PRINUM
DEFINE PRIMAC NUM,(ADDR),(MASK)
ADDR
TERMIN
PRIADR: PRILST
DEFINE PRIMAC NUM,(ADDR),(MASK)
MASK
TERMIN
PRIMSK: PRILST
SRTADF: BLOCK 1 ;Flag for SRTADR
;⊗ HSTNXA
; HSTNXA -- Return descriptor block for a host
; Call: MOVE 3,<number return by HSTNAM as address block>
; PUSHJ 17,HSTNXA
; <error return--no other addresses>
; <return--absolute NAMNUM in 0, next address block in 3>
; Does not disturb 1,2
.U"HSTNXA:
SKIPN HSTADR ; fail if host table not mapped
FATAL Host table not mapped
MOVE 0,@HSTADR
CAME 0,HSTFIL
FATAL Bad host table
HRRZ 3,ADRCDR(3) ; get other address(es), if any
JUMPE 3,[ SETZ 0, ; if no addresses left, fail
POPJ 17,]
ADD 3,HSTADR
MOVE 0,ADDADR(3) ; get this address
AOS (17)
POPJ 17, ; failure
;⊗ SVCCHK SVCCH1 SVCCH2 SVCCH3
;SVCCHK -- Check address block for a specific service.
;Call: MOVE 3,<number returned by HSTNUM, HSTNAM, or HSTNXA as address block>
; MOVEI 1,[ASCIZ/string to match/]
; PUSHJ 17,SVCCHK
; <return if string not in service list>
; <return if string in service list>
;Preserves 0-3. Smashes 4-10.
.U"SVCCHK:
SKIPN HSTADR ;Fail if host table not mapped
FATAL Host table not mapped
HRRZ 4,ADRSVC(3) ;Address of services list
SVCCH1: JUMPE 4,CPOPJ ;No services, or end of list
ADD 4,HSTADR
HRRZ 5,SVRNAM(4) ;Get name of service
ADD 5,HSTADR
HRLI 5,440700 ;Set up byte pointers
MOVSI 6,440701
SVCCH2: ILDB 7,5
ILDB 10,6
JUMPE 7,[JUMPE 10,CPOPJ1 ;Succeed if simultaneous end
JRST SVCCH3] ;Try next if one ends early
JUMPE 10,SVCCH3
CAMN 7,10
JRST SVCCH2 ;Match, keep checking
SVCCH3: HRRZ 4,SVRCDR(4) ;Get next service node
JRST SVCCH1
;⊗ SETANM SETAN1 SETAN2
; SETANM -- Generate alias name from host name
; Call: <call to HSTNUM or HSTNAM to set up HDB pointer>
; PUSHJ 17,SETANM
; Smashes 0 → 3.
IFN HSTSIX,[
↑SETANM:HRLI 1,440700 ;Byte ptr to official name or dotted address
MOVSI 2,440600 ;Byte ptr to output word in 0
SETZ 0,
SKIPN HDBPTR ;Do we have a real HDB?
HRLI 1,350700 ;No, dotted address. Skip over bracket
MOVE 3,(1) ;Get first word of name
TRZ 3,377 ;Check 4 chars
CAME 3,[ASCII/TIP-/] ;Is it "TIP-something"?
CAMN 3,[ASCII/Tip-/] ;Or "Tip-something"?
HRLI 1,100700 ;Yes, skip over "TIP-"
SETAN1: ILDB 3,1 ;Get a character
JUMPE 3,SETAN2 ;Jump if all done
CAIN 3,".
SKIPN HDBPTR ;Dots are OK in dotted addresses
JRST .+2
JRST SETAN2 ;End name at dot (don't show domain)
CAIN 3,"-
JRST SETAN1 ;Ignore hyphens
CAIL 3,"a ;Map lowercase to uppercase
SUBI 3,40
SUBI 3,40 ;Convert ascii to sixbit
IDPB 3,2
TLNE 2,770000 ;Stop after getting one full word
JRST SETAN1
SETAN2: TRNN 0,-1 ;If right half of "alias" is zero,
IORI '. ; then add a dot to make it "longer"
SETO 1,
GETLIN 1
AOSN 1 ;Don't screw DSK PPN if not a phantom
DSKPPN
POPJ 17,
]; End IFN HSTSIX
ifn 0,[ ;Old version
; SETANM -- Generate alias name from host name
; Call: <call to HSTNUM or HSTNAM to set up HDB pointer>
; PUSHJ 17,SETANM
; Smashes 0 → 7 (!!!).
IFN HSTSIX,[
.U"SETANM:
HRRZ 6,1 ; check official name first
SKIPN 1,HDBPTR
JRST SETA00 ; no host was found, use dotted host nbr
MOVE 2,HSTADR
HRRZ 2,NAMPTR(2) ; get address of NAMES table.
ADD 2,HSTADR
SKIPA 3,(2) ; number of entries in the table.
SETA00: MOVEI 3,0 ; no match earlier, don't look again
SETOB 4,5 ; 4 ← longest name ≤ 6 chars, 5 ← length
AOJA 2,SETAN0 ; skip word 1 of table (entry length)
SETAN1: ADDI 2,1 ; next untried NAMES table entry.
HLRZ 6,(2)
CAME 6,1 ; name the host we are serving?
JRST SETAN4
HRRZ 6,(2) ; how long is this name?
ADD 6,HSTADR
SETAN0: HRLI 6,440700
PUSH 17,6
PUSH 17,6
SETZ 7,
SETAN2: ILDB 6,(17)
SKIPE 6
AOJA 7,SETAN2
POP 17,6 ; flush garbage
POP 17,6 ; restore pointer to name
CAIG 7,6 ; fit in 6 characters?
CAMG 7,4 ; and longer than the previous one?
JRST SETAN4
HRRZ 5,6 ; save name's address
MOVE 4,7 ; and the length
SETAN4: SOJG 3,SETAN1 ; look through the rest of the table.
JUMPGE 4,SETAN5 ; jump if found a reasonable name
MOVEI 4,"- ; also, will remove hyphens from it
SKIPN 5,HDBPTR
JRST SETAN9 ; no host name at all, using dotted nbr
ADD 5,HSTADR ; no short name, truncate official one
HLRZ 5,STLNAM(5)
ADD 5,HSTADR ; pointer to name
SETAN5: SKIPA 2,5
SETAN9: MOVEI 2,(6) ; ptr to dotted host number string
HRLI 2,440700 ; get BP to name string.
MOVE 1,(2) ; Get beginning of name
TRZ 1,377 ; Check 4 chars
CAME 1,[ASCII/TIP-/] ; Is it "TIP-something"?
CAMN 1,[ASCII/Tip-/] ; Or "Tip-something"?
HRLI 2,100700 ; Yes, skip over "TIP-"
TRZ 1,77777 ; Check 3 chars
CAMN 1,[ASCII/SU-/] ; Is it "SU-something"?
HRLI 2,170700 ; Yes, skip over "SU-"
MOVSI 1,440600
SETZ 0, ; convert name to SIXBIT word in 0
SETAN6: ILDB 3,2
JUMPE 3,SETAN7 ; stop if name string runs out
CAMN 3,4 ; remove hyphens if requested to
JRST SETAN6 ; note 4 has number from 1 to 6 or "-
CAIL 3,"a
SUBI 3,40 ;Map to upper case
SUBI 3,<" >-<' >
IDPB 3,1
TLNE 1,770000 ; stop after getting one full word.
JRST SETAN6
SETAN7: LDB 3,1 ; if last character is a hyphen, flush it.
CAIN 3,'-
SETZ 3,
DPB 3,1
SETAN8: TRNN 0,-1 ; if right half of "alias" is zero,
IORI '. ; then add a dot to make it "longer"
SETO 1,
GETLIN 1
AOSN 1 ; don't screw DSK PPN if not a phantom
DSKPPN
POPJ 17,
]; End IFN HSTSIX
];ifn 0
;⊗ HSTNBR IPNBR HSTNBE PUPNBR TXTNUM TXTNU1
;HSTNBR -- Convert numeric text string to host number
;Call: MOVE 0,<addr of text, or byte ptr>
; PUSHJ 17,HSTNBR
; <error--illegal number>
; <return, host number in 1, updated byte ptr in 0>
;Clobbers 2-4.
;Skips over optional leading "[", parses a.b.c.d in decimal (IP address)
;or a#b in octal (PUP address), and skips over optional trailing "]".
.U"HSTNBR:
TLNN 0,-1
HRLI 0,440700
MOVE 1,0 ;Copy byte ptr
ILDB 2,1 ;Peek at first char
CAIL 2,"0
CAILE 2,"9
JRST [ CAIE 2,"[ ;Delimiter?
POPJ 17, ;No, then illegal
MOVE 0,1 ;Skip over delimiter
JRST .+1]
PUSHJ 17,TXTNUM
CAIN 2,".
JRST IPNBR
CAIN 2,"#
JRST PUPNBR
POPJ 17,
IPNBR: MOVE 1,3
PUSHJ 17,TXTNUM
CAIE 2,".
POPJ 17,
LSH 1,8.
ADD 1,3
PUSHJ 17,TXTNUM
CAIE 2,".
POPJ 17,
LSH 1,8.
ADD 1,3
PUSHJ 17,TXTNUM
LSH 1,8.
ADD 1,3
HSTNBE: CAIN 2,"]
ILDB 2,0
JRST CPOPJ1
PUPNBR: MOVE 1,4 ;Use octal for PUP
PUSHJ 17,TXTNUM
LSH 1,8.
ADD 1,4
ADD 1,[NW%SU] ;Set "Unternet" network
JRST HSTNBE
;Subroutine to parse digits into a number, both decimal and octal.
TXTNUM: SETZB 3,4 ;Clear both numbers
TXTNU1: ILDB 2,0 ;Get next char
CAIL 2,"0
CAILE 2,"9
POPJ 17, ;Not a digit
IMULI 3,=10
ADDI 3,-"0(2) ;Decimal
IMULI 4,10
ADDI 4,-"0(2) ;Octal
JRST TXTNU1
;⊗ HNUMST HNUMS1 HNUMS2 HNUMS3 HNUMS5 HNUMSD HNUMSO HNUMSX
;HNUMST -- Generate text string from host number
;Call: MOVE 0,<host number>
; MOVE 1,<address to store text string, or IDPB pointer>
; PUSHJ 17,HNUMST
;Assumes enough space for string and final null byte. (Currently at most 16.
;characters.) Smashes 2, 3, and 4 (preserves 0 and 1).
.U"HNUMST:
PUSH 17,1 ;Save address
TLNN 1,-1 ;Byte ptr in 1?
HRLI 1,440700 ;No, make one
JUMPE 0,HNUMS4 ;Return blank string for address 0
MOVEI 2,"[ ;Start with a bracket
IDPB 2,1
GETNET 4,0 ;Get network number
CAMN 4,[NW%SU] ;Is it the Ethernet?
JRST HNUMS5 ;Yes, generate subnet#host
PUSH 17,[401000,,0] ;Byte ptr to ILDB for host number
JRST HNUMS2
HNUMS1: MOVEI 2,". ;insert dot between parts of host number
IDPB 2,1 ;stuff into host "name" string (actually host nbr)
HNUMS2: ILDB 2,(17) ;get next byte of host nbr
PUSHJ 17,HNUMSD ;convert to decimal string
MOVE 2,(17)
TLNE 2,770000 ;end of word in byte ptr?
JRST HNUMS1 ;no, output more parts of host nbr
ADJSP 17,-1 ;flush byte ptr from stack
HNUMS3: MOVEI 2,"] ;end with a bracket
IDPB 2,1
HNUMS4: MOVEI 2,0 ;Terminate host string with a null
IDPB 2,1
POP 17,1 ;Restore original addr
POPJ 17,
HNUMS5: LDB 2,[101000,,0] ;Get subnet number
PUSHJ 17,HNUMSO ;Convert to octal string
MOVEI 2,"# ;Insert delimiter
IDPB 2,1
LDB 2,[001000,,0] ;Get host number
PUSHJ 17,HNUMSO ;Put in host number string
JRST HNUMS3 ;Finish up
HNUMSD: SKIPA 4,[10.] ;Usual decimal output routine
HNUMSO: MOVEI 4,10 ;Octal output
HNUMSX: IDIV 2,4
HRLM 3,(17)
JUMPE 2,.+2
PUSHJ 17,HNUMSX
HLRZ 3,(17)
ADDI 3,"0
IDPB 3,1 ;Stick digit into host string
POPJ 17,
;⊗ OURNAM OURNA1
;OURNAM -- Get our host name
;Call: PUSHJ 17,OURNAM
; <error return--can't get our name>
; <return--absolute NAMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2,
; address block in 3>
; Smashes 0, 1, 2, 3, and 4.
.U"OURNAM:
MOVEI 1,355 ;Lowcore ptr to table of host numbers
PEEK 1, ;Get AOBJN ptr
JUMPGE 1,CPOPJ
;Loop thru system table until we find a name
OURNA1: HRRZ 0,1 ;System address of next name in table
PEEK 0, ;Get host number
PUSH 17,1 ;Save AOBJN ptr
PUSHJ 17,HSTNUM
JRST [ POP 17,1 ;Failed
AOBJN 1,OURNA1 ;Try next number
POPJ 17,] ;Lose if we tried them all
POP 17,(17) ;Flush AOBJN ptr
JRST CPOPJ1
;⊗ ATTHST ATTHS0 ATTHS2 ATTCRE ATTMUL ATTUPP ATTLOW ATTERR MXATTE HSGNAM
;ATTHST -- Attach to upper segment that has the host table in it,
; or create one if necessary.
;Call: PUSHJ 17,ATTHST
; <return>
;Preserves ALL ACs.
.U"ATTHST:
PUSH 17,3 ;preserve all ACs
MOVE 3,HSGNAM ;get upper segment name
ATTHS0: ATTSEG 3, ;try to attach to segment
JRST ATTHS2 ;failed, see why
MOVEI 3,400000
MOVEM 3,HSTADR ;set host table address
POP 17,3
POPJ 17,
ATTHS2: HLLM 3,-1(17) ;save error code's left half
ANDI 3,-1 ;just error code
CAIL 3,MXATTE ;reasonable error?
MOVEI 3,MXATTE ;no
JRST @ATTERR(3) ;dispatch on error
;Create upper segment and read host table into it.
ATTCRE: PUSH 17,0
PUSH 17,1
PUSH 17,2
PUSHJ 17,MAPHS2 ;read host table into new upper segment, AC 3 already saved
MOVEI 1,1
SETUWP 1, ;write protect upper segment
JFCL ;error should never happen
MOVE 1,HSGNAM
SETNM2 1, ;rename it so others can share it
JFCL ;error should never happen
POP 17,2
POP 17,1
POP 17,0
POP 17,3
POPJ 17,
;Attach one of multiple uppers with same name
ATTMUL: HLRZ 3,-1(17) ;job number of one job with given name
JRST ATTHS0 ;try again
ATTUPP: FATAL ATTHST called with existing upper segment in use.
ATTLOW: FATAL ATTHST called with lower segment bigger than 128K.
ATTERR: ATTCRE ;protection violation, create new segment
ATTMUL ;multiple upper segments, attach one
ATTCRE ;no such upper segment job number
ATTCRE ;no such upper segment job name
ATTUPP ;already have an upper
ATTLOW ;lower segment is too big
MXATTE==.-ATTERR
.U"HSGNAM:SIXBIT/HOSTS!/ ;name of upper segment
;⊗ DETHST
;DETHST -- Detach upper segment (that has host table in it, presumably).
;Call: PUSHJ 17,DETHST
; <return>
;Preserves ALL ACs.
.U"DETHST:
SETZM HSTADR ;no more host table in upper
;; DETSEG 1, ;detach upper but don't let it go away when we're RESET
PUSH 17,0
MOVEI 0,0
CORE2 0, ;Release upper segment
JFCL ;Impossible error
POP 17,0
POPJ 17,
]; End IFN HSTTAB
;⊗ B%ADDRESS B%EXISTS B%DEFL VERSIO BLKSIZ NETADR NUMTTY DEFBLK TTYBLK TTYSTR TTYST1 CPYNAM CPYNA1 TTYST9 TTYREA TTYRE1
;TTYSTR -- Get TTY location string for SU-Ethernet host
;Call: MOVE 1,[BYTE(2)0(8)net,host(18)line]
; PUSHJ 17,TTYSTR
; <error return - not in table>
; <success, byte ptr to TTY location string in 1>
;Smashes 0-4. Temporarily uses one page of core above JOBFF (allocating
;if necessary, but not deallocating), and I/O channel 0. FINGER and maybe
;other programs allocate their own core and fake JOBFF before calling here.
IFN TTYSTS,[
COMMENT \
[Copied from <FINGER.SOURCES>TINIDF.MAC at Score. Watch out for unannounced
changes in the format of the TTYINI.BIN files. Note: we don't currently use
the "default" information for hosts.
If changing this code, recompile: CHTSER (PUP001), ARPSER (PUP131),
NETFNG (FINGER).]
TTYINI.NET-BIN File format:
Page 0:
Word 0: TTYINI version number of file (VERSION).
Word 1: Size of blocks in TTYINI entries (BLKSIZ).
Words 2-511: Net pointers, indexed by net number. Each pointer
points to a page (called a NET page) in the file.
A word of all ones is a null pointer (symbolic address
NETADR).
NET pages (mapped at NETPAG):
Words 0-511: Host pointers, indexed by host number. These pointers
point to the TTYINI data for each host, and are page
numbers (HOST pages). A word of all ones is a null
pointer (symbolic address NETPGA). If not -1 but the
left half is nonzero then this is a pointer to another
host.
HOST pages (mapped at HSTPAG):
Word 0: Number of TTYINI blocks for this host (number of lines on
host, symbolic name NUMTTY).
Words 1-end: TTYINI blocks (TTYBLK).
TTYINI blocks:
Each line has an associated terminal block of the following format:
TYPE
ttynumber = RECORD (* TTYNumber *)
NetNumber,
HostNumber: 9bit integer unsigned;
LineNumber: short integer unsigned;
END (* TTYNumber is a word of net, host,, line number *)
directiontype = (toleft, toright, acrossglass, facing,
diagonally-opposite, behind, acrosspartition, unused);
(* For fing/neighbor *)
locationtype = (ceras105, ceraslobby, cerasother, terman104,
termanother, termanlobby, dialin, gandalf, ethernvt,
arpanvt, decnvt, internetnvt, pty, erl206, meyer,
larkin); (* Typical locations *)
flagtype = (consultant, assignable, overhead, formfeed, lowercase,
tabs, pagepause, commandpause, raise, flag);
tty = RECORD (* Tty *)
ttytype, (* Terminal type number, or -1 if ? *)
defttytype, (* Default type number or -1 if ? *)
length, (* Terminal length or -1 if ? *)
width: integer; (* Terminal width or -1 if ? *)
(* Total 4 wds *)
address: PACKED ARRAY[1..30] OF char;
(* String for finger. 6 wds *)
location: locationtype; (* Where it is for finger. 1 wd *)
neighbors: PACKED ARRAY [directiontype] OF ttynumber;
(* For FINGER/NEIGHBORS. 8 wds *)
dplxmode: (fullduplex, noduplex, halfduplex, linehduplex);
(* 1 wd *)
bits: PACKED SET OF flagtype;
(* Bits. 2 wds currently *)
print-node: PACKED ARRAY [1..10] OF char;
(* 6 letter DECnet node name. 2 wds *)
END (* Tty *) (* 24 words, currently *)
\
;Constants we need
B%ADDRESS==4 ;Index of address string
B%EXISTS==33 ;Index of word which is 0 if entry exists, else -1
B%DEFL==34 ;Length of default TTYINI block
;Page 0 of TTYINI.NET-BIN
VERSIO==0 ;Version number of TTYINI.NET-BIN
BLKSIZ==1 ;Size of each TTY's block
NETADR==2 ;Table of network page pointers
;Host pages
NUMTTY==0 ;Number of lines on host
DEFBLK==1 ;Default TTYINI block for this host
TTYBLK==1+B%DEFL ;Start of TTYINI data for host
.U"TTYSTR:
PUSH 17,1 ;Save argument
INIT 0,17
'DSK,,
0
FATAL DSK INIT failure
DMOVE 0,TTYFIL
MOVE 3,TTYPPN
LOOKUP
JRST TTYST9 ;Return quietly if file not there
MOVE 4,JOBFF ;Start of one-page data area
;AC 4 will hold this value from now on.
MOVEI 0,777(4) ;Highest address in page
CAMG 0,JOBREL ;Do we have enough core?
JRST TTYST1 ;Yes
CORE 0, ;Get more core from system maybe
FATAL CORE UUO failure
TTYST1: MOVEI 1,0 ;Get page 0
PUSHJ 17,TTYREA
MOVE 0,BLKSIZ(4) ;Copy blocksize while we have it here
MOVEM 0,TTBSIZ
LDB 1,[321017,,0] ;Network number
ADDI 1,NETADR(4) ;Index into list of pages
SKIPN 1,(1) ;File page for network
JRST TTYST9 ;Unknown network
PUSHJ 17,TTYREA ;Read network page
LDB 1,[221017,,0] ;Host number
ADDI 1,(4) ;Index into list of pages
SKIPG 1,(1) ;File page for host
JRST TTYST9 ;Unknown host
TLNE 1,-1 ;Pointer to another host?
JRST TTYST9 ;Yes, deal with this later
MOVE 3,1 ;Remember page number
PUSHJ 17,TTYREA ;Read first page of host info
HRRZ 1,(17) ;Line number
CAMLE 1,NUMTTY(4) ;Compare with max for this host
MOVEI 1,0 ;Out of range: use name for line 0
IMUL 1,TTBSIZ ;Offset of TTY info block
ADDI 1,TTYBLK ;Skip header preceding first block
MOVEI 2,-1(1)
ADD 2,TTBSIZ ;Offset of last word in block
CAIG 2,777 ;Is block within page 0?
JRST CPYNAM ;Yes, we have it
PUSH 17,1 ;Remember start of block
XOR 2,1
TRNE 2,777000 ;Are start and end within same page?
JRST [ LSH 1,-8. ;No, get 1/2 pages before and after start
LSH 1,1
LSH 3,2 ;File addr of first page of host info
ADD 1,3
PUSHJ 17,TTYRE1
POP 17,1
ANDI 1,377 ;New offset
JRST CPYNAM]
LSH 1,-9. ;Get page containing entire block
ADD 1,3
PUSHJ 17,TTYREA
POP 17,1
ANDI 1,777
CPYNAM: ADDI 1,(4) ;Start of block for this line
SKIPE B%EXISTS(1) ;Skip if entry exists
JRST TTYST9 ;No entry, return failure
CPYNA1: MOVSI 2,B%ADDRESS(1) ;Start of terminal location string
HRRI 2,TTYNAM ;Place to copy it to
BLT 2,TTYNAM+5 ;Copy 6 words
AOS -1(17) ;Set skip return
MOVE 1,[440700,,TTYNAM] ;Set return value
TTYST9: RELEAS ;Give up I/O channel
ADJSP 17,-1 ;Flush argument
POPJ 17,
;Subroutine to read a page of the binary file.
TTYREA: LSH 1,2 ;Convert pages to disk records
TTYRE1: USETI 0,1(1) ;First record is 1
MOVEI 0,-1(4) ;Construct IOWD
HRLI 0,-1000
SETZ 1, ;End IOWD list
INPUT 0,0
POPJ 17,
];End IFN TTYSTS
;⊗ CPOPJ2 CPOPJ1 CPOPJ WARNIN LUZBIG ..NLIT
; All good things must come to an end
; Return routines
CPOPJ2: AOS (17) ; double skip return
CPOPJ1: AOS (17) ; skip return
CPOPJ: POPJ 17, ; return to caller
; Warning
.U"WARNIN:
TMSG [
Please report this via GRIPE NETWORK.
]
POPJ 17,
; Fatality!
.U"LUZBIG:
TMSG [
Find a wizard.
]
JRST 4,WARNIN
..NLIT: CONSTANTS
.END NETWRK